perm filename OUTPUT.SAI[PNT,HE]8 blob
sn#467705 filedate 1979-08-12 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00004 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 ENTRY
C00003 00003 ! display: cvxs,cvxv,cvxr,cvxt,cvxf,cvxm,cvxp
C00007 00004 ! cvx,cvsym,cvssym,cvexpr
C00010 ENDMK
C⊗;
ENTRY;
BEGIN "OUTPUT"
DEFINE $OUTPUT=TRUE;
REQUIRE "HEADER.SAI" SOURCE_FILE;
INTEGER ARRAY W[1:10],D[1:10];
INTEGER STPTR;
PROCEDURE SFORMAT(INTEGER WIDTH,DIGITS);
BEGIN
STPTR←STPTR+1;
GETFORMAT(W[STPTR],D[STPTR]);
SETFORMAT(WIDTH,DIGITS);
END;
PROCEDURE GFORMAT;
BEGIN
SETFORMAT(W[STPTR],D[STPTR]);
STPTR←STPTR-1;
END;
! display: cvxs,cvxv,cvxr,cvxt,cvxf,cvxm,cvxp;
SIMPLE STRING PROCEDURE CVXS(REAL R; INTEGER MODE(TABLE_D));
BEGIN
STRING S1;
IF MODE=TABLE_D THEN SFORMAT(0,2) ELSE SFORMAT(0,3);
S1←CVF(R);
GFORMAT;
RETURN(SCAN(S1,$BSKTAB,$BRCHR)); ! to cancel the spaces;
END;
! returns a string with the rotation part;
SIMPLE STRING PROCEDURE CVXR(REAL ARRAY XF;INTEGER MODE(TABLE_D));
BEGIN
REAL W,PH,TH; STRING RS,SCA;
STRING BEG,MID,EN;
SIMPLE STRING PROCEDURE ROTFORM(STRING AXIS;REAL W);
RETURN(BEG&AXIS&MID&CVF(W)&EN);
IF MODE=TABLE_D
THEN BEGIN BEG←"("; MID←","; EN←")" END
ELSE BEGIN BEG←"ROT("; MID←"HAT,"; EN←"*DEG)" END;
TH←XF[4];PH←XF[5];W←XF[6]; RS←SCA←NULL;
SFORMAT(0,1);
IF ABS(TH)>$EPS THEN
BEGIN RS←RS&ROTFORM("Z",TH); SCA←"*"; END;
IF ABS(PH)>$EPS THEN
BEGIN RS←RS&SCA&ROTFORM("Y",PH); SCA←"*"; END;
IF ABS(W)>$EPS THEN
BEGIN RS←RS&SCA&ROTFORM("Z",W); SCA←"*"; END;
IF LENGTH(SCA)=0 THEN RS←"NILROT";
GFORMAT;
RETURN(SCAN(RS,$BSKTAB,$BRCHR));
END;
! returns a string with the vector part for frame assignments;
SIMPLE STRING PROCEDURE CVXV(REAL X,Y,Z;INTEGER MODE(TABLE_D));
BEGIN
STRING S,VECTOR,INCH;
IF MODE=FILE_D THEN
BEGIN VECTOR←"VECTOR"; INCH←"*INCHES"; SFORMAT(0,3); END
ELSE BEGIN VECTOR←INCH←NULL; SFORMAT(0,2); END;
IF ABS(X)<$EPS AND ABS(Y)<$EPS AND ABS(Z)<$EPS
THEN S←"NILVECT"&INCH
ELSE S←" "&VECTOR&"("&CVF(X)&","&CVF(Y)&","&CVF(Z)
&")"&INCH;
GFORMAT;
RETURN(SCAN(S,$BSKTAB,$BRCHR));
END;
SIMPLE STRING PROCEDURE CVTR(REAL ARRAY XF;INTEGER MODE(TABLE_D));
BEGIN
STRING S;
S←"("&CVXR(XF,MODE)&","&CVXV(XF[1],XF[2],XF[3],MODE)&")";
RETURN(SCAN(S,$BSKTAB,$BRCHR));
END;
SIMPLE STRING PROCEDURE CVXT(REAL ARRAY XF; INTEGER MODE(TABLE_D));
IF MODE=TABLE_D THEN RETURN(CVTR(XF,MODE))
ELSE RETURN("TRANS"&CVTR(XF,MODE));
SIMPLE STRING PROCEDURE CVXF(REAL ARRAY XF; INTEGER MODE(TABLE_D));
IF MODE=TABLE_D THEN RETURN(CVTR(XF,MODE))
ELSE RETURN("FRAME"&CVTR(XF,MODE));
SIMPLE STRING PROCEDURE CVXM(STRING S; INTEGER MODE(TABLE_D));
BEGIN INTEGER BRCHAR; STRING S1,S2;
S1←"⊂"&SCAN(S,$RBTAB,BRCHAR)&"⊃";
IF MODE≠TABLE_D THEN RETURN(S1);
S2←SCAN(S1,$CRTAB,BRCHAR);
WHILE S1 DO S2←S2&CRLF&" "&SCAN(S1,$CRTAB,BRCHAR);
RETURN(S2);
END;
SIMPLE STRING PROCEDURE CVXP(STRING S; INTEGER MODE(TABLE_D));
RETURN(S);
! cvx,cvsym,cvssym,cvexpr;
STRING PROCEDURE CVX(RANY T; INTEGER TYPE,MODE(TABLE_D));
BEGIN "cvx"
STRING S;
CASE TYPE OF
BEGIN
[#SC] S←CVXS(SCALAR:VALUE[T],MODE);
[#VT] S←CVXV(VECTOR:XC[T],VECTOR:YC[T],VECTOR:ZC[T],MODE);
[#RT] S←CVXR(ROT:XF[T],MODE);
[#TR] S←CVXT(TRANS:XF[T],MODE);
[#FR] S←CVXF(FRAME:XF[T],MODE);
[#MC] S←CVXM(MACRO:BODY[T],MODE);
[#PR] S←CVXP(PROC:BODY[T],MODE)
END;
RETURN(S);
END "cvx";
INTERNAL STRING PROCEDURE CVEXPR(RPTR(EXPR$)EX; INTEGER MODE(TABLE_D));
RETURN(CVX($EVALEXP(EX),EXPR$:TYPE[EX],MODE));
INTERNAL STRING PROCEDURE CVSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D));
! only gives the data part ;
CASE SYMBOL:ACCESS[SYM] OF
BEGIN
[#PROCEDURE]
RETURN(CVX(SYMBOL:OBJECT[SYM],SYMBOL:TYPE[SYM],MODE));
[#SIMPLE][#ARRAY_ELEMENT]
IF SYMBOL:TYPE[SYM]=#MC OR ($ELFABORTED AND (MODE=FILE_D))
THEN
RETURN(CVX(SYMBOL:OBJECT[SYM],SYMBOL:TYPE[SYM],MODE))
ELSE
RETURN(CVX($EVAL11(SYM),SYMBOL:TYPE[SYM],MODE));
[#ARRAY]
ERROR("CVSYM ERROR: cannot handle ARRAYS")
END;
INTERNAL STRING PROCEDURE CVSSYM(RPTR(SYMBOL)SYM; INTEGER MODE(TABLE_D));
! gives symbol and appends data part ;
CASE SYMBOL:ACCESS[SYM] OF
BEGIN
[#SIMPLE][#PROCEDURE][#ARRAY_ELEMENT]
BEGIN
STRING HEAD;
IF #SC≤SYMBOL:TYPE[SYM]≤#FR
THEN HEAD←" "&SYMBOL:PNAME[SYM]&" "
ELSE IF SYMBOL:TYPE[SYM]=#MC
THEN HEAD←" "&MACRO:HEAD[SYMBOL:OBJECT[SYM]]&(IF MODE=TABLE_D THEN
" " ELSE " = ")
ELSE HEAD←" "&PROC:HEAD[SYMBOL:OBJECT[SYM]]&" ";
RETURN(HEAD&CVSYM(SYM,MODE))
END;
[#ARRAY] ERROR("CVSSYM ERROR: cannot handle ARRAYS")
END;
END "OUTPUT"